home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Leser 19 / Amiga Plus Leser CD 19.iso / Online / AmigaTalk / examples / IceCreamStoreSim.st < prev    next >
Text File  |  2002-01-30  |  4KB  |  157 lines
  1. " Simple Minded simulation from Chapter 6 of 'A Little Smalltalk'.
  2.  
  3.   IceCream Store - multiple event queue
  4. "
  5.  
  6. Class Main
  7. [
  8.   main ! i !
  9.     i <- IceCreamStore new.
  10.  
  11.     [i time < 60] whileTrue: [ i proceed ].
  12.  
  13.     i reportProfits
  14. ]
  15.  
  16. Class Simulation ! currentTime eventQueue !
  17. [
  18.   new
  19.     eventQueue  <- Dictionary new.
  20.     currentTime <- 0
  21. |
  22.   time
  23.     ^ currentTime
  24. |
  25.   addEvent: event at: eventTime
  26.     (eventQueue includesKey: eventTime)
  27.       ifTrue:  [(eventQueue at: eventTime) add: event]
  28.       ifFalse: [eventQueue  at: eventTime put: (Set new ; add: event)]
  29. |   
  30.   addEvent: event next: timeIncrement
  31.     self addEvent: event at: currentTime + timeIncrement
  32. |
  33.   proceed | minTime eventset event |
  34.     minTime <- 99999.
  35.     eventQueue keysDo: [:x | (x < minTime) ifTrue: [minTime <- x]].
  36.  
  37.     currentTime <- minTime.
  38.     eventset    <- eventQueue at: minTime ifAbsent: [^nil].
  39.     event       <- eventset first.
  40.  
  41.     eventset remove: event.
  42.  
  43.     (eventset isEmpty) ifTrue: [eventQueue removeKey: minTime].
  44.     self processEvent: event
  45. ]
  46.  
  47. Class IceCreamStore :Simulation
  48. ! profit arrivalDistribution rand scoopDistribution remainingChairs !
  49. [
  50.   new
  51.     profit          <- 0.
  52.     remainingChairs <- 15.
  53.     rand            <- Random new.
  54.  
  55.     (arrivalDistribution <- Normal new)
  56.     setMean: 3.0 deviation: 1.0.
  57.     (scoopDistribution <- DiscreteProbability new)
  58.     defineWeights: #(65 25 10).
  59.     self scheduleArrival
  60. |
  61.   scheduleArrival | newcustomer time |
  62.     newcustomer <- Customer new.
  63.     time <- self time + (arrivalDistribution next).
  64.     (time < 15) ifTrue: [self addEvent: [self customerArrival: newcustomer]
  65.                               at: time
  66.                         ]
  67. |
  68.   processEvent: event
  69.     ('event received at ', self time printString) print.
  70.     event value.
  71.     self scheduleArrival
  72. |
  73.   customerArrival: customer   | size |
  74.     size <- customer groupSize.
  75.     ('group of size ', size printString , ' arrives') print.
  76.     (size < remainingChairs)
  77.       ifTrue: [remainingChairs <- remainingChairs - size.
  78.                 'take chairs, schedule order' print.
  79.                 self addEvent: [self customerOrder: customer]
  80.                 next: (rand randInteger: 3).
  81.               ]
  82.       ifFalse: ['finds no chairs, leave' print]
  83. |
  84.   customerOrder: customer      | size numScoops |
  85.     size      <- customer groupSize.
  86.     numScoops <- 0.
  87.  
  88.     size timesRepeat: [numScoops <- numScoops + scoopDistribution next].
  89.  
  90.     ('group of size ', size printString, ' orders ' ,
  91.     numScoops printString, ' scoops') print.
  92.  
  93.     profit <- profit + (numScoops * 0.17).
  94.  
  95.     self addEvent: [self customerLeave: customer] 
  96.              next: (rand randInteger: 5)
  97. |
  98.   customerLeave: customer | size |
  99.     size <- customer groupSize.
  100.     ('group of size ', size printString, ' leaves') print.
  101.     remainingChairs <- remainingChairs + customer groupSize
  102. |
  103.   reportProfits
  104.    ('profits are ', profit printString) print
  105. ]
  106.  
  107. Class Customer ! groupSize !
  108. [
  109.   new
  110.     groupSize <- (Random new "randomize") randInteger: 8
  111. |
  112.   groupSize
  113.     ^ groupSize
  114. ]
  115.  
  116. Class DiscreteProbability ! weights rand max !
  117. [
  118.   defineWeights: anArray
  119.     weights <- anArray.
  120.  
  121.     (rand <- Random new) "randomize".
  122.  
  123.     max <- anArray inject: 0 into: [:x :y | x + y]
  124. |
  125.   next   | index value |
  126.     value <- rand randInteger: max.
  127.     index <- 1.
  128.  
  129.     [value > (weights at: index)]
  130.        whileTrue: [value <- value - (weights at: index). 
  131.                             index <- index + 1
  132.                   ].
  133.     ^ index
  134. ]
  135.  
  136. Class Normal :Random ! mean deviation !
  137. [
  138.   new
  139.     self setMean: 1.0 deviation: 0.5
  140. |
  141.   setMean: m deviation: s
  142.     mean      <- m.
  143.     deviation <- s
  144. |
  145.   next ! v1 v2 s u !
  146.     s <- 1.
  147.  
  148.     [s >= 1] whileTrue: [v1 <- (2 * super next) - 1.
  149.                          v2 <- (2 * super next) - 1.
  150.                           s <- v1 squared + v2 squared
  151.                         ].
  152.  
  153.     u <- (-2.0 * s ln / s) sqrt.
  154.  
  155.     ^ mean + (deviation * v1 * u)
  156. ]
  157.